Dim nreg As Integer
Dim hRes As Worksheet

Private Sub btnEmail_Click()
    On Error GoTo error
    If tbEmail.Text = "" Then
        MsgBox("Ha de introducir una direccin de email vlida.")
        Exit Sub
    End If
    Dim appExcel As Excel.Application
    appExcel = New Excel.Application

    Dim fichero As File
    Dim Fso As FileSystemObject
    Dim Destino As Workbook
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Dim strHoja, strRuta, filename As String
    strHoja = ActiveCell.Worksheet.Name
    strRuta = ActiveWorkbook.path
    filename = strRuta & "\" & strHoja & ".xlsx"
    Fso = New FileSystemObject
    If Fso.FileExists(filename) Then
        Destino = appExcel.Workbooks.Open(filename)
    Else
        Dim nhojas As Integer
        nhojas = appExcel.SheetsInNewWorkbook
        appExcel.SheetsInNewWorkbook = 1
        Destino = appExcel.Workbooks.Add()
        Destino.Saved = True
        Destino.SaveAs(filename)
        appExcel.SheetsInNewWorkbook = nhojas
    End If
    Destino.Activate()
    Application.EnableEvents = True
    ThisWorkbook.Activate()
    Dim hd As Worksheet
    hd = Destino.Worksheets(1)
    Dim i, j As Integer
    For i = 1 To hRes.UsedRange.Cells.Rows.Count
        For j = 1 To 3
            hd.Cells(i, j).Value = hRes.Cells(i, j).Value
            If i = 1 Then
                hd.Cells(i, j).Style = "nfasis1"
            End If
        Next j
    Next i
    hd.Columns.AutoFit()
    Destino.Worksheets(1).Name = strHoja
    Destino.Saved = True
    Destino.Save()
    Destino.SendMail(Recipients:=tbEmail.Text, Subject:="Valoracion mensual (" & strHoja & ")", returnreceipt:=True)
    Destino.Close()
    Destino = Nothing
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    appExcel = Nothing
    Exit Sub
error:
    MsgBox(Err.Description)
    appExcel = Nothing
End Sub

Private Sub btnNueva_Click()
    Dim nueva As Worksheet
    hRes.Copy(after:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count))
    nueva = ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)
    nueva.Name = busca_nombre
    nueva.Activate()
    carga_cbHoja()
    hRes = Worksheets(cbHoja.List(cbHoja.ListIndex))
End Sub

Function busca_nombre() As String
    Dim existe As Boolean
    existe = True
    Dim nombre, nombre_nuevo As String
    Dim partes As Object
    partes = Split(hRes.Name, "_")
    nombre = partes(UBound(partes))
    Dim i, anyo, mes As Integer
    While existe = True
        existe = False
        anyo = Mid(nombre, 1, 4)
        mes = Mid(nombre, 5, 2)
        mes = mes + 1
        If mes > 12 Then
            anyo = anyo + 1
            mes = 1
        End If
        nombre_nuevo = "Recursos_" & anyo & Format(mes, "00")
        For i = 1 To ActiveWorkbook.Worksheets.Count
            If ActiveWorkbook.Worksheets(i).Name = nombre_nuevo Then existe = True
        Next i
        If existe = True Then
            nombre = nombre_nuevo
        End If
    End While
    busca_nombre = nombre_nuevo
End Function

Private Sub btnSalir_Click()
    Unload(Me)
End Sub

Private Sub cbHoja_Change()
    If cbHoja.ListIndex <> -1 Then
        hRes = Worksheets(cbHoja.List(cbHoja.ListIndex))
        hRes.Activate()
        If nreg > hRes.UsedRange.Cells.Rows.Count Then
            nreg = hRes.UsedRange.Cells.Rows.Count
        End If
        lbRecursos.RowSource = hRes.Range("A2:C" & hRes.UsedRange.Cells.Rows.Count).Address
        If nreg > 0 Then
            mostrar_registro(nreg)
        End If
        lbRecursos.SetFocus()
    End If
End Sub

Private Sub cbPuntualidad_Change()
    hRes.Cells(nreg + 1, 4).Value = cbPuntualidad.Value
    tbVpuntualidad.Text = tbCpuntualidad.Text * (cbPuntualidad.ListIndex + 1)
    suma()
End Sub

Private Sub cbExtra_Change()
    hRes.Cells(nreg + 1, 5).Value = cbExtra.Value
    tbVextra.Text = tbCextra.Text * (cbExtra.ListIndex + 1)
    suma()
End Sub

Private Sub cbCalidad_Change()
    hRes.Cells(nreg + 1, 6).Value = cbCalidad.Value
    tbVcalidad.Text = tbCcalidad.Text * (cbCalidad.ListIndex + 1)
    suma()
End Sub

Private Sub cbVelocidad_Change()
    hRes.Cells(nreg + 1, 7).Value = cbVelocidad.Value
    tbVvelocidad.Text = tbCvelocidad.Text * (cbVelocidad.ListIndex + 1)
    suma()
End Sub

Private Sub cbAutonomia_Change()
    hRes.Cells(nreg + 1, 8).Value = cbAutonomia.Value
    tbVautonomia.Text = tbCautonomia.Text * (cbAutonomia.ListIndex + 1)
    suma()
End Sub

Private Sub cbTratoUsers_Change()
    hRes.Cells(nreg + 1, 9).Value = cbTratoUsers.Value
    tbVtrato.Text = tbCtrato.Text * (cbTratoUsers.ListIndex + 1)
    suma()
End Sub

Private Sub cbSolidaridad_Change()
    hRes.Cells(nreg + 1, 10).Value = cbSolidaridad.Value
    tbVsolidaridad.Text = tbCsolidaridad.Text * (cbSolidaridad.ListIndex + 1)
    suma()
End Sub

Private Sub lbRecursos_Click()
    nreg = lbRecursos.ListIndex + 1
    mostrar_registro(nreg)
End Sub

Private Sub UserForm_Initialize()
    carga_cbHoja()
    hRes = Worksheets(cbHoja.List(cbHoja.ListIndex))
    cbPuntualidad.RowSource = "Tablas!A2:A4"
    cbExtra.RowSource = "Tablas!B2:B5"
    cbCalidad.RowSource = "Tablas!C2:C5"
    cbVelocidad.RowSource = "Tablas!D2:D5"
    cbAutonomia.RowSource = "Tablas!E2:E4"
    cbTratoUsers.RowSource = "Tablas!F2:F5"
    cbSolidaridad.RowSource = "Tablas!G2:G5"
    Dim f As Integer
    lbRecursos.RowSource = hRes.Range("A2:C" & hRes.UsedRange.Cells.Rows.Count).Address
    lbRecursos.ColumnWidths = "50;100;90"
    lbRecursos.Selected(0) = True
    nreg = 1
    mostrar_registro(nreg)
    lbRecursos.SetFocus()
End Sub

Sub carga_cbHoja()
    cbHoja.Clear()
    Dim h As Worksheet
    For Each h In ActiveWorkbook.Worksheets
        If h.Name <> "Tablas" Then
            cbHoja.AddItem(h.Name)
        End If
    Next
    cbHoja.ListIndex = cbHoja.ListCount - 1
End Sub

Sub mostrar_registro(nreg As Integer)
    tbCodigo.Text = hRes.UsedRange.Cells(nreg + 1, 1).Value
    tbNombre.Text = hRes.UsedRange.Cells(nreg + 1, 2).Value
    cbPuntualidad.Value = hRes.UsedRange.Cells(nreg + 1, 4).Value
    cbExtra.Value = hRes.UsedRange.Cells(nreg + 1, 5).Value
    cbCalidad.Value = hRes.UsedRange.Cells(nreg + 1, 6).Value
    cbVelocidad.Value = hRes.UsedRange.Cells(nreg + 1, 7).Value
    cbAutonomia.Value = hRes.UsedRange.Cells(nreg + 1, 8).Value
    cbTratoUsers.Value = hRes.UsedRange.Cells(nreg + 1, 9).Value
    cbSolidaridad.Value = hRes.UsedRange.Cells(nreg + 1, 10).Value
    suma()
End Sub

Sub suma()
    tbTotal.Text = CDbl(tbVpuntualidad.Text) + CDbl(tbVextra.Text) + _
    CDbl(tbVcalidad.Text) + CDbl(tbVvelocidad.Text) + _
    CDbl(tbVautonomia.Text) + CDbl(tbVtrato.Text) + _
    CDbl(tbVsolidaridad.Text)
    clasificar()
End Sub

Sub clasificar()
    Dim res As Integer
    Dim color As Long
    Dim valor As Double
    valor = CDbl(tbTotal.Text)
    If valor < Worksheets("Tablas").Cells(16, 2).Value Then
        res = 1
        color = vbRed
    ElseIf valor < Worksheets("Tablas").Cells(16, 3).Value Then
        res = 2
        color = vbYellow
    ElseIf valor < Worksheets("Tablas").Cells(16, 4).Value Then
        res = 3
        color = vbHighlight
    Else
        res = 4
        color = vbGreen
    End If
    tbRes.Text = Worksheets("Tablas").Cells(15, res).Value
    hRes.UsedRange.Cells(nreg + 1, 3).Value = tbRes.Text
    tbRes.BackColor = color
End Sub
